home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / COMP / TEST / REALERRO.M < prev    next >
Encoding:
Text File  |  1990-12-17  |  1.1 KB  |  68 lines
  1. MODULE RealError;
  2.  
  3. (*
  4.  * Testet diverse Real-Exceptions
  5.  *)
  6.  
  7. IMPORT GEMDOSIO; (*$E MOS *)
  8. FROM InOut IMPORT Write, WriteString, Read, WriteLn;
  9. FROM EasyExceptions IMPORT Call, Exception, StdErrNo;
  10. FROM HdlError IMPORT GetErrorMsg;
  11. FROM Strings IMPORT Space, String;
  12. IMPORT MathLib0;
  13.  
  14.  
  15. PROCEDURE teste (p: PROC; soll: ARRAY OF CHAR);
  16.  
  17.   VAR s: String; result: Exception;
  18.  
  19.   BEGIN
  20.     Call (p, result);
  21.     WriteString (soll);
  22.     WriteString (Space (20-LENGTH(soll)));
  23.     WriteString (' -- ');
  24.     GetErrorMsg (StdErrNo (result), s);
  25.     WriteString (s);
  26.     WriteLn;
  27.   END teste;
  28.  
  29. VAR r1, r2: REAL;
  30.  
  31. PROCEDURE a;
  32.   BEGIN
  33.     r1:= 0.;
  34.     r2:= 1.;
  35.     r2:= r2 / r1
  36.   END a;
  37.  
  38. PROCEDURE b;
  39.   BEGIN
  40.     r1:= 0.;
  41.     r2:= r1 / r1
  42.   END b;
  43.  
  44. PROCEDURE c;
  45.   BEGIN
  46.     r1:= 2.;
  47.     LOOP
  48.       r1:= r1 * r1
  49.     END
  50.   END c;
  51.  
  52. PROCEDURE d;
  53.   BEGIN
  54.     r1:= MathLib0.ld(0.);
  55.   END d;
  56.  
  57. PROCEDURE e;
  58.   BEGIN
  59.     r1:= MathLib0.ld(0.);
  60.   END e;
  61.  
  62. BEGIN
  63.   teste (a, 'DIV BY 0');
  64.   teste (b, 'Ill. Ops');
  65.   teste (c, 'Overflow');
  66.   teste (d, 'OutOfRange');
  67. END RealError.
  68.